; ORIGINAL: 3dt2.1/examples/schemers/egsolids.scm
;;
;; egsolids.scm
;;
;; A collection of procedures that build the various "challenge" solids
;; described in Chapter 1 of the "Getting Started" book.
;;
;; Edward C. Martin, Schemers Inc.
;; 29 August 1993
;;

(require 'viewer "viewer.scm")

(define brick
  (lambda ()
    (blocks)
    (block "A" (position -10 -20 -20) (position -20 10 20))
    (block "B" (position -20 10 -20) (position 10 20 20))
    (block "C" (position 10 20 -20) (position 20 -10 20))
    (block "D" (position 20 -10 -20) (position -10 -20 20))
    (unite "A" "B" "C" "D" "brick")))

(define tictactoe
  (lambda ()
    (begin
      (blocks)
      (block "block" (position -40 -40 -5) (position 40 40 5))
      (hide "block")
      (block "H1" (position -35 -35 5) (position -15 -15 0))
      (block "H2" (position -35 -10 5) (position -15 10 0))
      (block "H3" (position -35 15 5) (position -15 35 0))
      (block "H4" (position -10 -35 5) (position 10 -15 0))
      (block "H5" (position -10 -10 5) (position 10 10 0))
      (block "H6" (position -10 15 5) (position 10 35 0))
      (block "H7" (position 15 -35 5) (position 35 -15 0))
      (block "H8" (position 15 -10 5) (position 35 10 0))
      (block "H9" (position 15 15 5) (position 35 35 0))
      (unite "H1" "H2" "H3" "H4" "H5" "H6" "H7" "H8" "H9" "holes")
      (subtract "block" "holes" "board")
      (change-eye-to (position 25 -80 30)))))

(define barbell
  (lambda ()
    (begin
      (blocks)
      (cylinder "bar" (position -50 0 0) (position 50 0 0) 2)
      (cylinder "L1" (position -48 0 0) (position -46 0 0) 5)
      (cylinder "R1" (position 48 0 0) (position 46 0 0) 5)
      (cylinder "L2" (position -46 0 0) (position -44 0 0) 10)
      (cylinder "R2" (position 46 0 0) (position 44 0 0) 10)
      (cylinder "L3" (position -44 0 0) (position -42 0 0) 15)
      (cylinder "R3" (position 44 0 0) (position 42 0 0) 15)
      (cylinder "L4" (position -42 0 0) (position -40 0 0) 20)
      (cylinder "R4" (position 42 0 0) (position 40 0 0) 20))))

(define keyhole
  (lambda ()
    (begin
      (blocks)
      (block "A" (position -15 -5 -25) (position 15 5 25))
      (hide "A")
      (block "B" (position -5 -5 -20) (position 5 5 10))
      (cylinder "C" (position 0 -5 10) (position 0 5 10) 10)
      (unite "B" "C" "H")
      (subtract "A" "H" "keyhole"))))

(define jack
  (lambda ()
    (begin
      (blocks)
      (cylinder "C1" (position 0 0 -30) (position 0 0 30) 5)
      (cylinder "C2" (position -30 0 0) (position 30 0 0) 5)
      (sphere "S1" (position 0 0 -30) 8)
      (sphere "S2" (position 0 0 30) 8)
      (sphere "S3" (position -30 0 0) 8)
      (sphere "S4" (position 30 0 0) 8)
      (cone "K1" (position 0 0 0) (position 0 -38 0) 7 5)
      (cone "K2" (position 0 0 0) (position 0 38 0) 7 5))))

(define eyeball
  (lambda ()
    (begin
      (blocks)
      (sphere "S1" (position 0 -42 -11.2) 58)
      (sphere "S2" (position 0 42 -11.2) 58)
      (intersect "S1" "S2" "I1")
      (sphere "S3" (position 0 0 -42) 58)
      (subtract "I1" "S3" "I2")
      (hide "I2")
      (sphere "S4" (position 0 -42 11.2) 58)
      (sphere "S5" (position 0 42 11.2) 58)
      (intersect "S4" "S5" "I3")
      (sphere "S6" (position 0 0 42) 58)
      (subtract "I3" "S6" "I4")
      (reveal "I2")
      (change-eye-to (position 0 -50 10))
      (sphere "S7" (position 0 0 0) 10))))

;;; end of file  egsolids.scm
